home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b6.d64 / plot'char.l < prev    next >
Text File  |  2007-02-28  |  2KB  |  112 lines
  1. 9000 DIM DUMMY$ OF 25
  2. 9002 BUILD'SUB
  3. 9004 PROC PLOT'CHAR(X,Y,C$,C'SET) CLOSED
  4. 9006 IF Y<7 OR Y>199 OR X<0 OR X>312 THEN GOTO EXIT
  5. 9008 IY:=199-INT(Y)
  6. 9010 P:=INT(X) MOD 8
  7. 9012 TWO'TO'P:=2^P; TWO'P'8:=2^(8-P)
  8. 9014 S:=7-(IY MOD 8)
  9. 9016 COLOR:=PEEK(53281)-240+16*PEEK(646)
  10. 9018 C'CD:=ORD(C$)
  11. 9020 IF C'CD=255 THEN C'CD:=126
  12. 9022 CASE (C'CD DIV 32) OF
  13. 9024 WHEN 0,4
  14. 9026 C'CD:=32
  15. 9028 WHEN 2,5,7
  16. 9030 C'CD:=C'CD-64
  17. 9032 WHEN 3
  18. 9034 C'CD:=C'CD-32
  19. 9036 WHEN 6
  20. 9038 C'CD:=C'CD-128
  21. 9040 OTHERWISE 
  22. 9042 ENDCASE 
  23. 9044 CASE C'SET OF
  24. 9046 WHEN 0
  25. 9048 BASE:=53248
  26. 9050 WHEN 1
  27. 9052 BASE:=54272
  28. 9054 WHEN 2
  29. 9056 BASE:=55296
  30. 9058 WHEN 3
  31. 9060 BASE:=56320
  32. 9062 OTHERWISE 
  33. 9064 ENDCASE 
  34. 9066 C'ADDR:=8*C'CD+BASE
  35. 9068 DIS'INT
  36. 9070 I'O:=PEEK(1)
  37. 9072 POKE 1,8*(I'O DIV 8)+(I'O MOD 4)
  38. 9074 CA:=C'ADDR; R:=IY
  39. 9076 CBA:=COLOR'BYTE'ADDR(X,R)
  40. 9078 POKE CBA,COLOR
  41. 9080 IF P<>0 THEN
  42. 9082 POKE CBA+1,COLOR
  43. 9084 ENDIF 
  44. 9086 WHILE R<=IY+S DO
  45. 9088 DOTS:=PEEK(CA)
  46. 9090 CBA:=CELL'BYTE'ADDR(X,R)
  47. 9092 LB:=DOTS DIV TWO'TO'P
  48. 9094 AND'BYTE(CBA,LB)
  49. 9096 IF P<>0 THEN
  50. 9098 RB:=TWO'P'8*(DOTS-LB*TWO'TO'P)
  51. 9100 AND'BYTE(CBA+8,RB)
  52. 9102 ENDIF 
  53. 9104 CA:=CA+1; R:=R+1
  54. 9106 ENDWHILE 
  55. 9108 IF S<=7 THEN
  56. 9110 CBA:=COLOR'BYTE'ADDR(X,R)
  57. 9112 POKE CBA,COLOR
  58. 9114 IF P<>0 THEN
  59. 9116 POKE CBA+1,COLOR
  60. 9118 ENDIF 
  61. 9120 WHILE R<=IY+7 DO
  62. 9122 DOTS:=PEEK(CA)
  63. 9124 CBA:=CELL'BYTE'ADDR(X,R)
  64. 9126 LB:=DOTS DIV TWO'TO'P
  65. 9128 AND'BYTE(CBA,LB)
  66. 9130 IF P<>0 THEN
  67. 9132 RB:=TWO'P'8*(DOTS-LB*TWO'TO'P)
  68. 9134 AND'BYTE(CBA+8,RB)
  69. 9136 ENDIF 
  70. 9138 CA:=CA+1; R:=R+1
  71. 9140 ENDWHILE 
  72. 9142 ENDIF 
  73. 9144 POKE 1,PEEK(1)+4
  74. 9146 ENA'INT
  75. 9148 EXIT:
  76. 9150 ENDPROC PLOT'CHAR
  77. 9152 //
  78. 9154 FUNC CELL'BYTE'ADDR(X,IY) CLOSED
  79. 9156 RETURN 57344+320*(IY DIV 8)+8*(X DIV 8)+(IY MOD 8)
  80. 9158 ENDFUNC CELL'BYTE'ADDR
  81. 9160 //
  82. 9162 FUNC COLOR'BYTE'ADDR(X,IY) CLOSED
  83. 9164 RETURN 55296+40*(IY DIV 8)+X DIV 8
  84. 9166 ENDFUNC COLOR'BYTE'ADDR
  85. 9168 //
  86. 9170 PROC DIS'INT CLOSED
  87. 9172 POKE 56334,2*(PEEK(56334) DIV 2)
  88. 9174 ENDPROC DIS'INT
  89. 9176 //
  90. 9178 PROC ENA'INT CLOSED
  91. 9180 POKE 56334,PEEK(56334)+1
  92. 9182 ENDPROC ENA'INT
  93. 9184 //
  94. 9186 PROC AND'BYTE(ADDR,BYTE) CLOSED
  95. 9188 POKE 251,(ADDR MOD 256)
  96. 9190 POKE 252,(ADDR DIV 256)
  97. 9192 POKE 253,BYTE
  98. 9194 SYS 45031
  99. 9196 ENDPROC AND'BYTE
  100. 9198 //
  101. 9200 PROC BUILD'SUB CLOSED
  102. 9202 B:=45031
  103. 9204 FOR A:=B TO B+24 DO
  104. 9206 READ N
  105. 9208 POKE A,N
  106. 9210 ENDFOR A
  107. 9212 DATA 120,165,1,133,254,41,249
  108. 9214 DATA 9,1,133,1,160,0,177,251
  109. 9216 DATA 5,253,145,251
  110. 9218 DATA 165,254,133,1,88,96
  111. 9220 ENDPROC BUILD'SUB
  112.